Wstęp

Cel projektu

Projekt analizy wyników badań PISA 2018 został wykonany w ramach przedmiotu Wstęp do eksploracji danych na Wydziale Matematyki i Nauk Informacyjnych Politechniki Warszawskiej. Celem projektu było zaznajomienie się z pakietem plot_ly wykorzystującym interaktywne wykresy do obrazowania danych statystycznych.

Badania PISA 2018

PISA jest miedzynarodowym badaniem umiejętności piętnastolatków w zakresie trzech obszarów:

  • matematyki,
  • nauk przyrodniczych,
  • czytania.

Ma ono na celu sprawdzenie i porównanie jakości edukacji i przeprowadzane jest (z wyjątkiem przerwy spowodowanej pandemią COVID19) co 3 lata, w tym także w roku 2018. W tym badaniu wzięlo udział 79 krajów i regionów ze wszystkich zamieszkałych kontynentów. Z każego badania publikowane są szczegółowe wyniki dotyczące nie tylko rezultatów osiągniętych przez uczniów, ale też prezentujące ich styl życia, samopoczucie czy plany na przyszłość. Respondentami są - oprócz uczniów - także rodzice i dyrektorzy szkół.

Temat pracy

W raporcie przeanalizowano dwa aspekty badań:

  • porównanie wyników krajów ze względu na rezultaty w każdym z trzech głównych obszarów badania, z podziałem na kontynenty,
  • porównanie średniej liczby punktów dla krajów z poszczególnych kwartyli zamożności (mierzonej według PKB per Capita) do średniej liczby punktów wszystkich krajów.

Wyniki obu analiz prezentowane są niżej w postaci interaktywnych wykresów.

Dane

Dane dotyczące wyników raportu zostały pobrane ze strony https://www.oecd.org/pisa/. Dane o wskaźnikach PKB per Capita dla roku 2018 wzięto ze stron https://countryeconomy.com/ i https://data.worldbank.org/.

Porównanie wyników krajów ze względu na rezultaty w każym z trzech głównych obszarów badania PISA 2018, z podziałem na kontynenty.

Kod

library(plotly)
library(dplyr)

wyniki <- read.csv("wyniki.csv")
wyniki <- select(wyniki, -X)


#tworzenie wykresu
plot3d <- plot_ly(
  data = wyniki, 
  x = ~Matematyka, 
  y = ~Nauki_Scisle, 
  z = ~Czytanie,
  color = ~Kontynent, 
  colors = "Set1",
  type = "scatter3d",
  mode = "markers",
  text = paste0("Kraj: ", wyniki$Kraj, "<br>Kontynent: ", wyniki$Kontynent),
  hovertemplate = paste('<b>%{text}</b><br><b>Matematyka</b>: %{x}<br><b>Nauki Scisle</b>: %{y}<br><b>Czytanie</b>: %{z} <extra></extra>')
)


plot3d <- plot3d %>% 
  layout(title = list(text = "Wyniki padań PISA 2018 według krajów w 3 głównych obszarach, \nz podziałem na kontynenty", size = 15), 
         scene = list(xaxis = list(title = "Matematyka"),
                      yaxis = list(title = "Nauki Ścisłe"),
                      zaxis = list(title = "Czytanie")), 
         legend = list(title=list(text='<b> Kontynent </b>')))

Wykres

Kliknij na obszarze wykresu, aby go obrócić. Najedź kursorem na interesujący Cię punkt, aby wyświetlić szczegóły.

Komentarz

Punkty na powyższym wykresie są ułożone a miarę jednostajnie. Co więcej - nie widać znaczących odchyleń od głównej przekątnej, co może sugerować, że poszczególne kraje osiągały w każym z 3 obszarów badań wyniki zbliżone do siebie. Faktycznie, średnia różnica między najwyższym i najniższym wynikiem wynosi niecałe 18 punktów.

Jeśli spojrzymy na kontynenty, zauważymy silne rozwarstwienie w wynikach dla krajów azjatyckich, w przeciwieństwie do państw Ameryki Południowej. Dostrzec mozna też dużą grupę europejskich państw plasujących się w tuż za plecami azjatyckich liderów.

Porównanie średniej liczby punktów dla krajów z poszczególnych kwartyli zamożności (mierzonej według PKB per Capita) do średniej liczby punktów wszystkich krajów.

Obserwacje z powyższego wykresu pozwalają przypuszczać, że średnia liczba zdobytych punktów w 3 obszarach jest dobrym wskaźnikiem wyników kraju.

Wskaźnik PKB per Capita dotyczy roku 2018, w którym odbywało się badanie PISA.

Kod

wyniki <- wyniki %>% 
  mutate(kwartylPKB = ntile(PKBperCapita, 4))
  
qplot <- plot_ly(x = ~wyniki$srednia, 
                 type = "box", 
                 visible = T, 
                 name = "Wszystkie kraje",
                 text = paste0("Kraj: ", wyniki$Kraj),
                 hovertemplate = paste('<b>%{text}</b><br><b>Średnia</b>: %{x} <extra></extra>'),
                 showlegend = F
                )
qplot <- qplot %>% 
  add_trace(type = "box",
          x = wyniki[wyniki$kwartylPKB==1,]$srednia,
          name = "1. Kwartyl",
          visible = T,
          text = paste0("Kraj: ", wyniki[wyniki$kwartylPKB==1,]$Kraj),
          hovertemplate = paste('<b>%{text}</b><br><b>Średnia</b>: %{x} <extra></extra>')) %>%
  add_trace(type = "box",
          x = wyniki[wyniki$kwartylPKB==2,]$srednia,
          name = "2. kwartyl",
          visible = F,
          text = paste0("Kraj: ", wyniki[wyniki$kwartylPKB==2,]$Kraj),
          hovertemplate = paste('<b>%{text}</b><br><b>Średnia</b>: %{x} <extra></extra>'))%>% 
  add_trace(type = "box",
          x = wyniki[wyniki$kwartylPKB==3,]$srednia,
          name = "3. kwartyl",
          visible = F,
          text = paste0("Kraj: ", wyniki[wyniki$kwartylPKB==3,]$Kraj),
          hovertemplate = paste('<b>%{text}</b><br><b>Średnia</b>: %{x} <extra></extra>'))%>% 
  add_trace(type = "box",
          x = wyniki[wyniki$kwartylPKB==4,]$srednia,
          name = "4. kwartyl",
          visible = F,
          text = paste0("Kraj: ", wyniki[wyniki$kwartylPKB==4,]$Kraj),
          hovertemplate = paste('<b>%{text}</b><br><b>Średnia</b>: %{x} <extra></extra>')) %>% 
  layout(
    updatemenus = list(
      list(
        type = "list",
        buttons = list(
          list(method = "restyle",
               args = list('visible', c(T,T,F,F,F)),
               label = "1 kwartyl PKB"),
          list(method = "restyle",
               args = list('visible', c(T,F,T,F,F)),
               label = "2 kwartyl PKB"),
          list(method = "restyle",
               args = list('visible', c(T,F,F,T,F)),
               label = "3 kwartyl PKB"),
          list(method = "restyle",
               args = list('visible', c(T,F,F,F,T)),
               label = "4 kwartyl PKB")
          )
        )
    ),
    title = list(text = "Porównanie średniej liczby punktów krajów \n z wybranego kwartylu PKB per Capita \n względem wszystkich krajów"),
    xaxis = list(title = "Średnia liczba punktów",
                range = c(min(wyniki$srednia), max(wyniki$srednia))),
    yaxis = list(title = "")
  )

Wykres

Wybierz z rozwijanej listy interesujący Cię kwartyl, aby zobaczyć jak kształtuje się dotyczący go wykres skrzynkowy na tle wszystkich krajów. Dodatkowo, po najechaniu na punkt symbolizujący wartość odstającą (outlier) dowiesz się, jakie państwo symbolizuje.

Komentarz

Zauważalne jest przesuwanie się wykresu skrzynkowego w prawo wraz ze wzrostem numeru kwartyla, co oznacza, że im bardziej zamożne państwo, tym lepsze wyniki osiągaja uczniowie.

Podsumowanie

Wynik badania nie pozostawiają złudzeń - wyraźnie widać, że miejsce urodzenia ma wpływ na to jak będzie wyglądała nasza przyszłość. Kraje bogate, z wysokim wskaźnikiem PKB per Capita, na ogół posiadają lepszy system edukacji od krajów biedniejszych, choć warto pamiętać, że utrzymanie dobrej jakości nauczania w krajach bogatych na ogół kosztuje więcej, z uwagi na wyższe pensje nauczycieli i wydatków na cały aparat oświaty.

Pokrzepiającym dla nas Polaków faktem może być wysoki wynik Polski. Zajęliśmy 10. miejsce, ale porównując się do krajów z naszego kwartylu PKB per Capita ustępujemy tylko Chinom, które osiągneły najlepszy wynik na całym świecie, będąc zdecydowanym outlierem w swoim kwartylu. Z państw biedniejszych od nas o jedną pozycję wyżej plasuje się jedynie Wietnam, czyli kolejne państwo określanie potocznie mianem azjatyckiego tygrysa.